home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / HAM8Decode.AMOS / HAM8Decode.amosSourceCode
Encoding:
AMOS Source Code  |  1997-09-22  |  6.2 KB  |  249 lines
  1. Dim DIT(3,7)
  2. Gosub INIT
  3. STP=10
  4. For FUMP=0 To 19
  5.   F$="c4d:andifinal/Andi."+ Extension_8_0EB8(FUMP,4)
  6.    Extension_8_0456 F$,9
  7.   STP=64-(FUMP+12)*2
  8.   Gosub REACHUNKY
  9.   Gosub GREY
  10.   Gosub WRITEBACK
  11. Next 
  12. For FUMP=0 To 31
  13.   F$="c4d:andifinal/Andi."+ Extension_8_0EB8(FUMP+2528,4)
  14.    Extension_8_0456 F$,9
  15.   STP=FUMP*2
  16.   Gosub REACHUNKY
  17.   Gosub GREYA
  18.   Gosub WRITEBACK
  19. Next 
  20. End 
  21. WRITEBACK:
  22.   ST=Start(9) : FLEN=Length(9)
  23.   Open Out 1,F$
  24.      Extension_8_17B6 1,ST To ST+12
  25.     AD=ST+12
  26.     Repeat 
  27.       SKIP=1
  28.       ID$=Peek$(AD,4)
  29.       LE=Leek(AD+4)
  30.       If ID$="BMHD"
  31.         Poke AD+8+10,0
  32.       End If 
  33.       If ID$="CMAP"
  34.         Print #1,ID$; Extension_8_08D2(64*3);
  35.         For A=0 To 63
  36.           Print #1,Chr$(Peek(CST+257+A*4));Chr$(Peek(CST+258+A*4));Chr$(Peek(CST+259+A*4));
  37.         Next 
  38.         SKIP=0
  39.       End If 
  40.       If ID$="BODY"
  41.         Reserve As Work 12,GX*GY
  42.         BMP=Start(12)
  43.         For Y=0 To GY-1
  44.           For P=0 To 7
  45.             For X=0 To GX-1 Step 8
  46.               B=0
  47.               For XX=0 To 7
  48.                 Add B,B
  49.                 If Peek(CST+BMOF+Y*GX+X+XX) and Extension_8_04F8(P)
  50.                   Inc B
  51.                 End If 
  52.               Next 
  53.               Poke BMP,B : Inc BMP
  54.             Next 
  55.           Next 
  56.         Next 
  57.         Print #1,ID$; Extension_8_08D2(GX*GY);
  58.          Extension_8_17B6 1,Start(12) To BMP
  59.         SKIP=0
  60.       End If 
  61.       If LE and 1 Then Inc LE
  62.       If SKIP Then Extension_8_17B6 1,AD To AD+8+LE
  63.       Add AD,8+LE
  64.     Until AD=ST+FLEN
  65.     NLEN=Pof(1)
  66.     Pof(1)=4
  67.     Print #1, Extension_8_08D2(NLEN-8);
  68.   Close 1
  69. Return 
  70. INIT:
  71.   Restore DITHER
  72.   For Y=0 To 7
  73.     For X=0 To 3
  74.       Read DIT(X,Y)
  75.     Next 
  76.   Next 
  77. Return 
  78. GREY:
  79.   Screen Open 0,GX,GY,32,0
  80.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  81.   For A=0 To 31
  82.     Colour A, Extension_8_0A0E((A/8)*5,((A/2) mod 4)*5,(A and 1)*15)
  83.   Next 
  84. '  For A=0 To 15 
  85. '    Colour A,A*$111 
  86. '  Next  
  87.   AD=CST+BMOF
  88.   For Y=0 To GY-1
  89.     RR=Peek(CST+257)
  90.     GG=Peek(CST+258)
  91.     BB=Peek(CST+259)
  92.     For X=0 To GX-1
  93.       C=Peek(AD+X+Y*GX)
  94. '      If C<64 
  95. '        RR=Peek(CST+257+C*4)
  96. '        GG=Peek(CST+258+C*4)
  97. '        BB=Peek(CST+259+C*4)
  98. '      End If  
  99.       If C>63 and C<128 Then BB=(C-64)*4 : Poke AD+X+Y*GX,Max(C-STP,64)
  100.       If C>127 and C<192 Then RR=(C-128)*4 : Poke AD+X+Y*GX,Max(C-STP,128)
  101.       If C>191 Then GG=(C-192)*4 : Poke AD+X+Y*GX,Max(C-STP,192)
  102. '      DR=DIT(X and 3,Y and 3)*2 
  103. '      DG=DIT((X+1) and 3,(Y+3) and 3)*2 
  104. '      DB=DIT((X+2) and 3,((Y+1) and 3)+4)*4 
  105. '      CC=Glue Colour(Min((RR+DR)/16,15),Min((GG+DG)/16,15),Min((BB+DB)/16,15))
  106. '      Turbo Plot X,Y,Best Pen(CC) 
  107. '      Turbo Plot X,Y,Min((RR+GG+BB+DIT(X and 3,Y and 3)*3)/48,15) 
  108.     Next 
  109.   Next 
  110.   For C=0 To 63
  111.     Poke CST+257+C*4,Max(Peek(CST+257+C*4)-STP*4,0)
  112.     Poke CST+258+C*4,Max(Peek(CST+258+C*4)-STP*4,0)
  113.     Poke CST+259+C*4,Max(Peek(CST+259+C*4)-STP*4,0)
  114.   Next 
  115. Return 
  116. GREYA:
  117.   Screen Open 0,GX,GY,32,0
  118.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  119.   For A=0 To 31
  120.     Colour A, Extension_8_0A0E((A/8)*5,((A/2) mod 4)*5,(A and 1)*15)
  121.   Next 
  122. '  For A=0 To 15 
  123. '    Colour A,A*$111 
  124. '  Next  
  125.   AD=CST+BMOF
  126.   For Y=0 To GY-1
  127.     RR=Peek(CST+257)
  128.     GG=Peek(CST+258)
  129.     BB=Peek(CST+259)
  130.     For X=0 To GX-1
  131.       C=Peek(AD+X+Y*GX)
  132.       If C<64
  133.         RR=Peek(CST+257+C*4)
  134.         GG=Peek(CST+258+C*4)
  135.         BB=Peek(CST+259+C*4)
  136.       End If 
  137.       If C>63 and C<128 Then BB=(C-64)*4 : Poke AD+X+Y*GX,Min(C+STP,127)
  138.       If C>127 and C<192 Then RR=(C-128)*4 : Poke AD+X+Y*GX,Min(C+STP,191)
  139.       If C>191 Then GG=(C-192)*4 : Poke AD+X+Y*GX,Min(C+STP,255)
  140.       DR=DIT(X and 3,Y and 3)*2
  141.       DG=DIT((X+1) and 3,(Y+3) and 3)*2
  142.       DB=DIT((X+2) and 3,((Y+1) and 3)+4)*4
  143.       CC= Extension_8_0A0E(Min((RR+DR)/16,15),Min((GG+DG)/16,15),Min((BB+DB)/16,15))
  144.        Extension_8_0388 X,Y, Extension_8_1504(CC)
  145. '      Turbo Plot X,Y,Min((RR+GG+BB+DIT(X and 3,Y and 3)*3)/48,15) 
  146.     Next 
  147.   Next 
  148.   For C=0 To 63
  149.     Poke CST+257+C*4,Min(Peek(CST+257+C*4)+STP*4,255)
  150.     Poke CST+258+C*4,Min(Peek(CST+258+C*4)+STP*4,255)
  151.     Poke CST+259+C*4,Min(Peek(CST+259+C*4)+STP*4,255)
  152.   Next 
  153. Return 
  154. REACHUNKY:
  155.   ST=Start(9) : LE=Length(9)
  156.   If Leek(ST)<> Extension_8_0998("FORM") Then Stop 
  157.   If Leek(ST+8)<> Extension_8_0998("ILBM") Then Stop 
  158.   If Leek(ST+4)+8<>LE Then Stop 
  159.   AD=ST+12
  160.   Repeat 
  161.     LCH=Leek(AD+4)
  162.     CHNK=Leek(AD)
  163.     If CHNK= Extension_8_0998("BMHD")
  164.       GX=Deek(AD+8)
  165.       GY=Deek(AD+10)
  166.       PL=Peek(AD+16)
  167.       PK=Peek(AD+18)
  168.       SX=Deek(AD+24)
  169.       SY=Deek(AD+26)
  170.       Reserve As Work 11,GX*GY+256+256*4+256*4
  171.       CST=Start(11) : BMOF=256*9
  172.       Doke CST,GX : Doke CST+2,GY
  173.       Doke CST+4,PL
  174.       Reserve As Work 10,4096
  175.       TST=Start(10)
  176.     End If 
  177. '    If CHNK=Asc.l("CAMG") 
  178. '      CAMG=Leek(AD+8) 
  179. '      Print Hex$(CAMG,8)
  180. '      Loke CST+8,CAMG 
  181. '    End If  
  182.     If CHNK= Extension_8_0998("CMAP")
  183.       For A=0 To(LCH/3)-1
  184.         RED=Peek(AD+8+A*3)
  185.         GRN=Peek(AD+9+A*3)
  186.         BLU=Peek(AD+10+A*3)
  187.         Poke CST+257+A*4,RED
  188.         Poke CST+258+A*4,GRN
  189.         Poke CST+259+A*4,BLU
  190.       Next 
  191.     End If 
  192.     If CHNK= Extension_8_0998("BODY")
  193.       X=0 : Y=0 : P=0 : PP=1
  194.       If PK
  195.         POS=AD+8
  196.         Repeat 
  197.           CON=Peek(POS) : Inc POS
  198.           If CON<128
  199.             For A=0 To CON
  200.               B=Peek(POS) : Gosub BYTEPUT
  201.               Inc POS
  202.             Next 
  203.           End If 
  204.           If CON>128
  205.             B=Peek(POS) : Inc POS
  206.             For A=0 To 256-CON
  207.               Gosub BYTEPUT
  208.             Next 
  209.           End If 
  210.         Until POS=>AD+8+LCH
  211.         If Y<>SY : FAIL=1 : End If 
  212.       Else 
  213.         For A=0 To LCH-1
  214.           B=Peek(AD+8+A)
  215.           Gosub BYTEPUT
  216.         Next 
  217.       End If 
  218.     End If 
  219.     If LCH and 1 Then Inc AD
  220.     Add AD,LCH+8
  221.   Until AD=>ST+LE
  222. Return 
  223. BYTEPUT:
  224.   If Y=>GY Then FAIL=1 : Y=0
  225.   Poke TST,B : Inc TST
  226.   Add X,8 : If(X and $FFF8)=>GX Then Inc P : X=0 : TST=Start(10)+P*512
  227.   If P=>PL
  228.     AA=CST+BMOF+Y*GX
  229.     TST=Start(10)
  230.     For X=0 To(GX/8)-1
  231.       P2C[TST+X,AA+X*8]
  232.     Next 
  233.     X=0 : Inc Y : P=0 : PP=1
  234.   End If 
  235. Return 
  236. DITHER:
  237. Data $0,$8,$2,$A
  238. Data $C,$4,$E,$6
  239. Data $3,$B,$1,$9
  240. Data $E,$7,$D,$5
  241.  
  242. Data $5,$C,$E,$3
  243. Data $8,$0,$6,$A
  244. Data $D,$2,$4,$E
  245. Data $7,$B,$9,$1
  246.  
  247. Procedure P2C[PLBUF,CHKBUF]
  248.    ' COMPILED PROCEDURE -- can't convert this to AMOS code
  249. End Proc